System Booster/System Booster.iso/Archives/ARexxTools/RexxEvent1_21.lha/RexxEvent/RexxEvent.e

Text File | 1995-04-23 | 5.2 KB | 231 lines

-> RexxEvent.e © 1995 by Leon Woestenberg.

-> This is Freeware. You may use (parts of) the code, but you may not
-> re-compile this code and spread the results under the name `RexxEvent'
-> or similar. Make up a quite unique name instead.

-> Please support Freeware :-)

-> Once started, sending an commodity-style input description to the
-> ARexx port 'REXXEVENT' will cause this event to happen.

-> Examples: rx 'ADDRESS REXXEVENT "<ctrl alt r>Only Amiga..."'

OPT PREPROCESS

MODULE 'dos/dos'
MODULE 'exec/nodes'
MODULE 'exec/ports'
MODULE 'commodities'
MODULE 'libraries/commodities'
MODULE 'rexxsyslib'
MODULE 'rexx/storage'
MODULE 'devices/inputevent'
MODULE 'devices/timer'

MODULE 'amigalib/cx'

MODULE '*RexxEvent_rev'

MODULE 'tools/debug'
MODULE '*E:Modules/dd_debugoff'

OBJECT commodity
  cxbroker
  cxport:PTR TO mp
  enabled
ENDOBJECT

OBJECT arexx
  port:PTR TO mp
ENDOBJECT

DEF commodity:PTR TO commodity
DEF arexx:PTR TO arexx

-> FOLD main
PROC main()
  DEF signals,quitflag=FALSE
  NEW commodity
  IF commodity.new()
    KPUTSTR('commodity broker active.\n')
    NEW arexx
    IF arexx.new()
      KPUTSTR('Waiting.\n')
      WHILE signals:=Wait(commodity.sigmask() OR
                          arexx.sigmask() OR
                          SIGBREAKF_CTRL_C)
        -> KRESET
        KPUTSTR('Signalled.\n')
        IF signals AND commodity.sigmask()
          quitflag:=commodity.handle()
        ENDIF
        IF signals AND arexx.sigmask()
          quitflag:=quitflag OR arexx.handle()
        ENDIF
        IF signals AND SIGBREAKF_CTRL_C
          quitflag:=TRUE
        ENDIF
        EXIT quitflag
        KPUTSTR('Waiting.\n')
      ENDWHILE
      END arexx
    ENDIF
    END commodity
  ENDIF
ENDPROC
-> ENDFOLD
-> FOLD insertEvents()
PROC insertEvents(inputdescr)
  DEF ie:PTR TO inputevent
  IF ie:=invertStringRev(inputdescr,0)
    AddIEvents(ie)
    freeIEvents(ie)
  ENDIF
ENDPROC
-> ENDFOLD
-> FOLD arexx
PROC new() OF arexx
  DEF name
  IF rexxsysbase:=OpenLibrary('rexxsyslib.library',0)
    Forbid()
    IF FindPort(name:='REXXEVENT')
      KPUTSTR('Public port already there.\n')
      self.port:=NIL
    ELSE
      self.port:=CreateMsgPort()
      IF self.port
        KPUTSTR('Public port added.\n')
        self.port.ln.name:=name
        self.port.ln.pri:=0
        AddPort(self.port)
      ENDIF
    ENDIF
    Permit()
  ENDIF
ENDPROC (self.port<>NIL)

PROC end() OF arexx
  IF self.port
    RemPort(self.port)
    DeleteMsgPort(self.port)
    self.port:=NIL
  ENDIF
  IF rexxsysbase
    CloseLibrary(rexxsysbase)
    rexxsysbase:=NIL
  ENDIF
ENDPROC

PROC sigmask() OF arexx IS Shl(1,self.port.sigbit)

PROC handle() OF arexx
  DEF msg:PTR TO rexxmsg
  DEF command
  DEF quitflag=FALSE
  WHILE msg:=GetMsg(self.port)

    KPUTSTR('Processing ARexx msg.\n')
    command:=Long(msg.args)

    msg.result1:=0
    msg.result2:=NIL
    IF StrCmp('QUIT',command)
      KPUTSTR('Quit.\n')
      quitflag:=TRUE
    ELSE
      KPUTFMT('Input description=\a\s\a\n',[command])
      IF commodity.enabled
        KPUTSTR('Let\as make an input event.\n')
        IF insertEvents(command)=FALSE
          -> set warning result
          msg.result1:=5
        ENDIF
      ENDIF
    ENDIF
    ReplyMsg(msg)
  ENDWHILE
ENDPROC quitflag
-> ENDFOLD
-> FOLD commodity
PROC handle() OF commodity
  DEF cxmsg,cxmsgtype,cxmsgid,cxmsgdata,quitflag=FALSE
  WHILE cxmsg:=GetMsg(self.cxport)

    cxmsgtype:=CxMsgType(cxmsg)
    cxmsgid:=CxMsgID(cxmsg)
    cxmsgdata:=CxMsgData(cxmsg)

    ReplyMsg(cxmsg)

    SELECT cxmsgtype
    CASE CXM_COMMAND
      SELECT cxmsgid
      CASE CXCMD_ENABLE
        KPUTSTR('Enabled.\n')
        self.enabled:=TRUE
      CASE CXCMD_DISABLE
        KPUTSTR('Disabled.\n')
        self.enabled:=FALSE
      CASE CXCMD_UNIQUE
        KPUTSTR('Other `me\a was tried to run, so quit.\n')
        quitflag:=TRUE
      -> CASE CXCMD_APPEAR
      -> CASE CXCMD_DISAPPEAR
      CASE CXCMD_KILL
        KPUTSTR('Kill.\n')
        quitflag:=TRUE
      ENDSELECT
    ENDSELECT
  ENDWHILE
ENDPROC quitflag

PROC new() OF commodity
  DEF cxerror
  IF cxbase:=OpenLibrary('commodities.library',0)
    self.cxport:=CreateMsgPort()
    IF self.cxport
      self.cxbroker:=CxBroker([NB_VERSION,
                               NIL,
                               'RexxEvent',
                               'RexxEvent',
                               'Emulates input events via ARexx port',
                               NBU_UNIQUE OR NBU_NOTIFY,
                               0,
                               0,
                               NIL,
                               self.cxport,
                               NIL]:newbroker,{cxerror})
      IF self.cxbroker
        KPUTSTR('broker could be created.\n')
        self.enabled:=TRUE
        ActivateCxObj(self.cxbroker,TRUE)
        RETURN TRUE
      ELSE
        KPUTFMT('CxBroker error=\d\n',[cxerror])
      ENDIF
    ENDIF
  ENDIF
ENDPROC

PROC end() OF commodity
  DEF cxmsg
  IF self.cxbroker
    DeleteCxObjAll(self.cxbroker)
    self.cxbroker:=NIL
  ENDIF
  IF self.cxport
    WHILE cxmsg:=GetMsg(self.cxport) DO ReplyMsg(cxmsg)
    DeleteMsgPort(self.cxport)
    self.cxport:=NIL
  ENDIF
  IF cxbase
    CloseLibrary(cxbase)
    cxbase:=NIL
  ENDIF
ENDPROC

PROC sigmask() OF commodity IS Shl(1,self.cxport::mp.sigbit)
-> ENDFOLD